replace_CH_CH_CH_target Function

private elemental function replace_CH_CH_CH_target(string, target, substring, every, back) result(rep_string)

Handle special cases when LEN(target) == 0. Such instances are prohibited by the standard, but since this function is elemental, no error can be thrown. Therefore, it makes sense to handle them in a sensible manner

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: string
character(len=*), intent(in) :: target
character(len=*), intent(in) :: substring
logical, intent(in), optional :: every
logical, intent(in), optional :: back

Return Value type(varying_string)


Variables

Type Visibility Attributes Name Initial
logical, private :: back_
logical, private :: every_
integer, private :: i_target
integer, private :: length_target
type(varying_string), private :: work_string

Source Code

  elemental function replace_CH_CH_CH_target (string, target, substring, every, back) result (rep_string)

    character(LEN=*), intent(in)  :: string
    character(LEN=*), intent(in)  :: target
    character(LEN=*), intent(in)  :: substring
    logical, intent(in), optional :: every
    logical, intent(in), optional :: back
    type(varying_string)          :: rep_string

    logical                       :: every_
    logical                       :: back_
    type(varying_string)          :: work_string
    integer                       :: length_target
    integer                       :: i_target


    if(LEN(target) == 0) then
       if(LEN(string) /= 0) then
          rep_string = string
       else
          rep_string = substring
       endif
       return
    end if

! Replace part of a character string with a character
! substring, at a location matching a character-
! string target

    if(PRESENT(every)) then
       every_ = every
    else
       every_ = .false.
    endif

    if(PRESENT(back)) then
       back_ = back
    else
       back_ = .false.
    endif

    rep_string = ''

    work_string = string

    length_target = LEN(target)

    replace_loop : do

       i_target = index(work_string, target, back_)

       if(i_target == 0) exit replace_loop

       if(back_) then
          rep_string = substring//extract(work_string, start=i_target+length_target)//rep_string
          work_string = extract(work_string, finish=i_target-1)
       else
          rep_string = rep_string//extract(work_string, finish=i_target-1)//substring
          work_string = extract(work_string, start=i_target+length_target)
       endif

       if(.NOT. every_) exit replace_loop

    end do replace_loop

    if(back_) then
       rep_string = work_string//rep_string
    else
       rep_string = rep_string//work_string
    endif

! Finish

    return

  end function replace_CH_CH_CH_target